# Replication Data for: Party campaign statements and portfolio allocation in coalition governments
# version 1.0 (October 27, 2022)
# 
# Please cite the related publication:
# Däubler, Thomas, Marc Debus and Alejandro Ecker (2022). "Party campaign statements and portfolio allocation in coalition governments." West European Politics. https://doi.org/10.1080/01402382.2022.2140397
# 
# file: simulation.R


# 0. initialize ---- 
## 0.1 default settings ----
rm(list = ls())
set.seed(31614862)

## 0.2 set working directory ----
setwd(YOUR MAIN DIRECTORY REPLICATION FILES)

## 0.3 install and load required packages ----
packs_needed <- c("ggplot2", "dplyr", "plyr", "MASS", "readstata13") 
installed_packs <- rownames(installed.packages())
packs_to_install <- packs_needed[!(packs_needed %in% installed_packs)]
if (length(packs_to_install) > 0) {
  install.packages(packs_to_install)
}

lapply(packs_needed, require, character.only = TRUE)

## 0.4 custom functions ----
# order of IVs: cabinet_seat_share, financeXcabinet_seat_share, 
#               salience_cmp, saliencepos_wmp
mypr <- function(mycmp, mywmp, mycmp2, mywmp2){
  x1 <- c(.15, 0, mycmp, mywmp)
  x2 <- c(1-x1[3], 0, mycmp2, mywmp2)
  prs <- exp(draws %*% x1)/(exp(draws %*% x1) + exp(draws %*% x2))
  out <- data.frame(mean=mean(prs), lb=quantile(prs,.05), ub=quantile(prs,.95))
  return(out)
}

## 0.5 load data sets ----
df_des <- read.dta13("data/portfolio_allocation.dta")
df_sim <- read.dta13("tmp/results_model5.dta") # 


# 1. descriptive analysis ----
prop.table(table(df_des$outcome))

cor(df_des[,c("salience_cmp", "salience_wmp", "saliencepos_wmp")])
summary(df_des$salience_cmp) 
summary(df_des$salience_wmp) 

df_des_uni <- unique(dplyr::select(df_des, country_cabinet_id, wmp_party_id, 
                                   salience_cmp, salience_wmp, saliencepos_wmp))

summary(df_des_uni$salience_cmp) 
quantile(df_des_uni$salience_cmp, c(.01,.99)) 

summary(df_des_uni$salience_wmp) 
summary(df_des_uni$saliencepos_wmp) 
quantile(df_des_uni$saliencepos_wmp, c(.01,.99)) 


# 2. simulation of predicted probabilities ----
## 2.1 draw from multivariate normal ----
nsim <- 5000
draws <- mvrnorm(nsim, df_sim[,1], df_sim[,2:5])

rulercmp <- seq(0, .25, by = .05)
rulerwmp <- seq(0, .3, by = .05)

## 2.2 estimate predicted probabilities as function of salience in party manifestos ----
mypr(0,.079, mycmp2 = .082, mywmp2 = .079)
mypr(.25,.079, mycmp2 = .082, mywmp2 = .079)

# settings for second party are from df_des_uni above
prcmpothmean <- plyr::ldply(rulercmp, mypr, mywmp =.079, mycmp2 = .082, mywmp2 = .079)
prcmpoth25 <- plyr::ldply(rulercmp, mypr, mywmp =.079, mycmp2 = .036, mywmp2 = .079)
prcmpoth75 <- plyr::ldply(rulercmp, mypr, mywmp =.079, mycmp2 = .117, mywmp2 = .079)
prcmp <- bind_rows(prcmpothmean, prcmpoth25, prcmpoth75)
prcmp$x <- rep(rulercmp,3)
prcmp$oth <- c(rep("mean",length(rulercmp)),rep("p25",length(rulercmp)),rep("p75",length(rulercmp)))
prcmp$x2 <- prcmp$x
prcmp$x2[prcmp$oth=="p25"] <- prcmp$x2[prcmp$oth=="p25"] - .01
prcmp$x2[prcmp$oth=="p75"] <- prcmp$x2[prcmp$oth=="p75"] + .01

## 2.3 estimate predicted probabilities as function of salience in party campaigns ----
mypr(.082,0, mycmp2 = .082, mywmp2 = .079)
mypr(.082,.3, mycmp2 = .082, mywmp2 = .079)

# settings for second party are from df_des_uni above
prwmpothmean <- plyr::ldply(rulerwmp, mypr, mycmp =.082, mycmp2 = .082, mywmp2 = .079)
prwmpoth25 <- plyr::ldply(rulerwmp, mypr, mycmp =.082, mycmp2 = .082, mywmp2 = .019)
prwmpoth75 <- plyr::ldply(rulerwmp, mypr, mycmp =.082, mycmp2 = .082, mywmp2 = .118)
prwmp <- bind_rows(prwmpothmean, prwmpoth25, prwmpoth75)
prwmp$x <- rep(rulerwmp,3)
prwmp$oth <- c(rep("mean",length(rulerwmp)),rep("p25",length(rulerwmp)),rep("p75",length(rulerwmp)))
prwmp$x2 <- prwmp$x
prwmp$x2[prwmp$oth=="p25"] <- prwmp$x2[prwmp$oth=="p25"] - .01
prwmp$x2[prwmp$oth=="p75"] <- prwmp$x2[prwmp$oth=="p75"] + .01

## 2.4 draw and export Figure 1 and Figure 2 ----
ggplot(prcmp, aes(x=x2, y=mean, ymin=lb, ymax=ub,
                  shape=factor(oth), colour=factor(oth), fill=factor(oth))) +
  geom_pointrange() +
  scale_x_continuous(breaks=seq(0,.25,by=.05)) +
  scale_colour_discrete(guide = 
                          guide_legend(title="Salience in manifesto of party 2")) +
  scale_fill_discrete(guide = 
                          guide_legend(title="Salience in manifesto of party 2")) +
  scale_shape_manual(values=c(21,25,24) ,guide = 
                          guide_legend(title="Salience in manifesto of party 2")) +
  labs(x="Salience in manifesto of party 1", 
       y="Predicted probability") +
   theme_bw() + theme(legend.position="bottom")

ggsave("out/figure_1.eps",
       dpi = 600, width=14, height=10, units="cm")

ggplot(prwmp, aes(x=x2, y=mean, ymin=lb, ymax=ub,
                  shape=factor(oth), colour=factor(oth), fill=factor(oth))) +
  geom_pointrange() +
  scale_x_continuous(breaks=seq(0,.3,by=.05)) +
  scale_colour_discrete(guide = 
                          guide_legend(title="Salience in campaign of party 2")) +
  scale_fill_discrete(guide = 
                        guide_legend(title="Salience in campaign of party 2")) +
  scale_shape_manual(values=c(21,25,24) ,guide = 
                       guide_legend(title="Salience in campaign of party 2")) +
  labs(x="Salience in campaign of party 1", 
       y="Predicted probability") +
  theme_bw() + theme(legend.position="bottom")

ggsave("out/figure_2.eps",
       dpi = 600, width=14, height=10, units="cm")
